home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 July / EnigmA AMIGA RUN 20 (1997)(G.R. Edizioni)(IT)[!][issue 1997-07 & 08][EAR-CD IV].iso / earcd / dev / amos / moreusel.lha / SoundConverter.AMOS / SoundConverter.amosSourceCode
AMOS Source Code  |  1997-04-15  |  8KB  |  264 lines
  1. ' ***************************************
  2. ' *                                     *
  3. ' *         SoundConverter V1.0         *
  4. ' *         Written by C. Hodges        *
  5. ' *                                     *
  6. ' ***************************************
  7. Set Buffer 40
  8. Def Fn GLW$(VAR)=Chr$(VAR/$1000000)+Chr$((VAR and $FF0000)/$10000)+Chr$((VAR and $FF00)/$100)+Chr$(VAR mod 256)
  9. Def Fn GNW$(VAR)=Chr$(VAR/256)+Chr$(VAR mod 256)
  10. Screen Open 0,640,256,4,$8000
  11. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  12. Limit Mouse 
  13. Palette 0,$FFF,$F0
  14. Dim DAT$(15,1),DAT(15,2)
  15. NSAM=0 : LO=0 : SAM=0 : Sam Loop Off 
  16. Gosub UPDAT
  17. Do 
  18.   I$=Upper$(Inkey$) : Multi Wait 
  19.   If I$="L" Then Sam Stop : Gosub LEASOUND : Gosub UPDAT
  20.   If I$="B" Then Sam Stop : Gosub LEABANK : Gosub UPDAT
  21.   If(NSAM>0) and(I$<>"") Then Gosub SAMCOMMANDS
  22.   If I$="Q" Then Sam Stop : End 
  23. Loop 
  24. End 
  25. SAMCOMMANDS:
  26.   If I$="C" Then Sam Stop : For A=1 To NSAM : Erase A : Next : NSAM=0 : Gosub UPDAT
  27.   If I$="A" Then Sam Stop : Gosub SAVBANK
  28.   If I$="S" Then Sam Stop : Gosub SAVSAM
  29.   If I$="T" Then Sam Stop 
  30.   If I$="V" Then Gosub DRASOUND
  31.   If I$="P" Then Sam Raw 15,DAT(SAM,0),DAT(SAM,1),DAT(SAM,2)
  32.   If I$="O" Then LO=1-LO : Sam Stop : Gosub UPDATLOOP
  33.   If I$="R" Then Sam Stop : Gosub DELSAM
  34.   If I$=Cright$ Then Add DAT(SAM,2),50,700 To 30000 : Gosub SIGLE : SAMPSPEED[15,DAT(SAM,2)]
  35.   If I$=Cleft$ Then Add DAT(SAM,2),-50,700 To 30000 : Gosub SIGLE : SAMPSPEED[15,DAT(SAM,2)]
  36.   If I$=Cup$ Then Sam Stop : Locate 0,13+SAM : Print "  " : Add SAM,-1,1 To NSAM : Locate 0,13+SAM : Print "->"
  37.   If I$=Cdown$ Then Sam Stop : Locate 0,13+SAM : Print "  " : Add SAM,1,1 To NSAM : Locate 0,13+SAM : Print "->"
  38. Return 
  39. SAVSAM:
  40.   Locate 0,11 : Cline 
  41.   Print "R) SAVE AS RAW   D) SAVE AS DUMP   I) SAVE AS IFF   A) ABORT"
  42.   A=0
  43.   Repeat 
  44.     I$=Upper$(Inkey$)
  45.     A=Abs((I$="R")+(I$="D")*2+(I$="I")*3+(I$="A"))
  46.   Until A
  47.   If A=4 Then Gosub UPDAT : Return 
  48.   F$=Fsel$("","","Enter a filename")
  49.   If F$="" Then Return 
  50.   On A Gosub SAVRAW,SAVDUMP,SAVIFF
  51.   Gosub UPDAT
  52. Return 
  53. DELSAM:
  54.   If SAM=NSAM Then Erase 16-SAM : Dec SAM : Dec NSAM : Gosub UPDAT : Return 
  55.   Bank Swap 16-SAM,16-NSAM
  56.   Swap DAT$(SAM,0),DAT$(NSAM,0)
  57.   Swap DAT$(SAM,1),DAT$(NSAM,1)
  58.   Swap DAT(SAM,0),DAT(NSAM,0)
  59.   Swap DAT(SAM,1),DAT(NSAM,1)
  60.   Swap DAT(SAM,2),DAT(NSAM,2)
  61.   Erase 16-NSAM : Dec NSAM
  62.   SAM=Min(NSAM,SAM)
  63.   Gosub UPDAT
  64. Return 
  65. UPDATLOOP:
  66.   If LO Then Sam Loop On : Locate 16,7 : Print "off" Else Sam Loop Off : Locate 16,7 : Print "on "
  67. Return 
  68. SIGLE:
  69.   Locate 51,13+SAM
  70.   Print "      ";At(51,);DAT(SAM,2);
  71. Return 
  72. UPDAT:
  73.   Cls : Home : Centre "Soundconverter V1.0 by Christopher Hodges" : Print : Print 
  74.   Print " L) Add sample"
  75.   Print " B) Load AMOS Bank"
  76.   Print " Q) Quit!"
  77.   If NSAM
  78.     Print 
  79.     Print " V) View sample       P) Play sample"
  80.     Print " O) Sample loop on    T) Stop sample"
  81.     Print "->) Increase freq.   <-) Decrement freq. "
  82.     Print " S) Save sample       R) Remove sample"
  83.     Locate 22,2 : Print "C) Clear all samples"
  84.     Locate 22,3 : Print "A) Save AMOS Bank"
  85.     Gosub UPDATLOOP
  86.     Locate 0,13 : Print "   Sample name                               length frequency type"
  87.     Locate 0,13+SAM : Print "->"
  88.     B=0
  89.     For A=1 To NSAM
  90.       Add B,DAT(A,1)
  91.       Locate 3,13+A : Print Left$(DAT$(A,0),40);At(44,);DAT(A,1);At(51,);DAT(A,2);At(62,);DAT$(A,1)
  92.     Next 
  93.     Locate 0,30 : Print "Total length:";B;" Bytes=";B/1024;" KB!";At(40,);"CHIP Memory Free:";Chip Free;" Bytes=";Chip Free/1024;" KB!"
  94.   Else 
  95.     Locate 0,30 : Print "CHIP Memory Free:";Chip Free;" Bytes=";Chip Free/1024;" KB!"
  96.   End If 
  97.   Locate 0,11 : Print "YOUR CHOICE: ";
  98. Return 
  99. DRASOUND:
  100.   Ink 0 : Bar 480,16 To 639,80
  101.   Ink 2 : Box 480,16 To 639,80
  102.   Draw 481,48 To 638,48
  103.   Plot 481,48,1 : XA=-1 : VA=128
  104.   For A=0 To DAT(SAM,1)
  105.     X=(A*157)/DAT(SAM,1)
  106.     V=Abs(Peek(DAT(SAM,0)+A)-128)
  107.     W=(W+(VA-V))/2 : VA=V
  108.     If X<>XA Then XA=X : Draw To X+481,48+W/2
  109.   Next 
  110. Return 
  111. End 
  112. SAVBANK:
  113.   F$=Fsel$("*.Abk","","Enter a filename")
  114.   If F$="" Then Return 
  115.   TL=2
  116.   For A=1 To NSAM
  117.     Add TL,DAT(A,1)+18
  118.   Next 
  119.   Open Out 1,F$
  120.     A$="AmBk"+ Fn GNW$(5)+ Fn GNW$(0)
  121.     A$=A$+Chr$(128)+Chr$(TL/$1000000)+ Fn GNW$(TL mod $10000)
  122.     A$=A$+"Samples "+ Fn GNW$(NSAM)
  123.     Print #1,A$; : A$=""
  124.     B=NSAM*4+2
  125.     For A=1 To NSAM
  126.       A$=A$+ Fn GLW$(B)
  127.       Add B,DAT(A,1)+14
  128.     Next 
  129.     Print #1,A$; : A$=""
  130.     For B=1 To NSAM
  131.       N$=Left$(DAT$(B,0),8)
  132.       While Len(N$)<8 : N$=N$+" " : Wend 
  133.       A$=N$+ Fn GNW$(DAT(B,2))+ Fn GLW$(DAT(B,1))
  134.       For A=0 To DAT(B,1)-1
  135.         A$=A$+Chr$(Peek(DAT(B,0)+A))
  136.         If A mod 1024=0 Then Print #1,A$; : A$=""
  137.       Next 
  138.       Print #1,A$;
  139.     Next 
  140.   Close 1
  141. Return 
  142. SAVDUMP:
  143.   Open Out 1,F$
  144.     A$= Fn GLW$(DAT(SAM,1))+ Fn GNW$(DAT(SAM,2))
  145.     Print #1,A$; : A$=""
  146.     For A=0 To L-1
  147.       A$=A$+Chr$(Peek(DAT(SAM,0)+A))
  148.       If A mod 1024=0 Then Print #1,A$; : A$=""
  149.     Next 
  150.     Print #1,A$;
  151.   Close 1
  152. Return 
  153. SAVRAW:
  154.   Bsave F$,DAT(SAM,0) To DAT(SAM,0)+DAT(SAM,1)
  155. Return 
  156. SAVIFF:
  157.   Open Out 1,F$
  158.     A=58+L
  159.     A$="FORM"+ Fn GLW$(58+DAT(SAM,1))+"8SVXVHDR"+ Fn GLW$(20)
  160.     A$=A$+ Fn GLW$(0)+ Fn GLW$(DAT(SAM,1))+ Fn GLW$(4)+ Fn GNW$(DAT(SAM,2))
  161.     A$=A$+Chr$(1)+Chr$(0)+Chr$(0)+Chr$(1)+ Fn GNW$(0)
  162.     A$=A$+"ATAK"+ Fn GLW$(6)+ Fn GNW$(0)+ Fn GLW$(0)
  163.     A$=A$+"RLSE"+ Fn GLW$(6)+ Fn GNW$(0)+ Fn GLW$(0)
  164.     Print #1,A$;
  165.     A$="BODY"+ Fn GLW$(DAT(SAM,1))
  166.     For A=0 To L-1
  167.       A$=A$+Chr$(Peek(DAT(SAM,0)+A))
  168.       If A mod 1024=0 Then Print #1,A$; : A$=""
  169.     Next 
  170.     Print #1,A$;
  171.   Close 1
  172. Return 
  173. LEASOUND:
  174.   Locate 0,13
  175.   If NSAM=15 Then Print "Sorry! Can't load more than 15 sounds at once!" : Wait 100 : Return 
  176.   F$=Fsel$("","","Select a soundfile")
  177.   If F$="" Then Return 
  178.   Inc NSAM
  179.   Open In 1,F$ : L=Lof(1) : Close 1
  180.   L=Max(L,258)
  181.   Erase 16-NSAM : Reserve As Chip Work 16-NSAM,L
  182.   AD=Start(16-NSAM)
  183. '  Fill AD To AD+L,0 
  184.   Bload F$,AD
  185.   Gosub CONVERT
  186.   If FI=0 Then Locate 9,13 : Cline : Print TYP$ : Wait 100 : Return 
  187.   DAT$(NSAM,1)=TYP$ : Inc SAM
  188. Return 
  189. CONVERT:
  190.   L=Max(L,258)
  191.   DAT$(NSAM,0)=F$ : FI=0
  192.   For A=Len(F$) To 1 Step -1
  193.     A$=Mid$(F$,A,1)
  194.     If(A$="/") or(A$=":") Then DAT$(NSAM,0)=Mid$(F$,A+1) : Exit 
  195.   Next 
  196.   If Fn GLW$(Leek(AD))="FORM" Then Gosub FOUNDIFF : Return 
  197.   If Leek(AD)=L-6 Then Gosub LEADUMP : Return 
  198.   If Leek(AD+4)=$50500FF Then Gosub LEASONIX : Return 
  199.   Gosub LEARAW
  200. Return 
  201. End 
  202. FOUNDIFF:
  203.   A=Leek(AD+8)
  204.   If Fn GLW$(A)="8SVX" Then TYP$="IFF 8SVX" : Gosub LEAIFF : Return 
  205.   If Fn GLW$(A)="SMUS" Then TYP$="IFF SMUS: Can't convert a whole music!" : Dec NSAM : Return 
  206.   If Fn GLW$(A)="ILBM" Then TYP$="IFF ILBM: Wanna view a picture???" : Dec NSAM : Return 
  207.   If Fn GLW$(A)="ANIM" Then TYP$="IFF ANIM: I'm confused! No anims!" : Dec NSAM : Return 
  208.   If Fn GLW$(A)="FTXT" Then TYP$="IFF FTXT: Est-ce que tu es fou???" : Dec NSAM : Return 
  209.   Print Fn GLW$(A);": Error!" : Dec NSAM : Return 
  210. Return 
  211. LEAIFF:
  212.   FREQ=15625 : A=AD+12
  213.   Repeat 
  214.     If Fn GLW$(Leek(A))="VHDR" Then FREQ=Deek(A+20)
  215.     If Fn GLW$(Leek(A))="BODY" Then L=Leek(A+4) : AD=A+8 : FI=1 : Exit 
  216.     Add A,4
  217.   Until A>AD+L-4
  218.   If FI=0 Then TYP$="IFF 8SVX: No BODY chunk!" : Dec NSAM : Return 
  219.   DAT(NSAM,0)=AD : DAT(NSAM,1)=L : DAT(NSAM,2)=FREQ
  220. Return 
  221. LEADUMP:
  222.   TYP$="DSound dump!" : FI=1
  223.   DAT(NSAM,0)=AD+8 : DAT(NSAM,1)=L-8 : DAT(NSAM,2)=Deek(AD+4)
  224. Return 
  225. LEASONIX:
  226.   TYP$="Sonix instrument!" : FI=1
  227.   DAT(NSAM,0)=AD+96 : DAT(NSAM,1)=L-96 : DAT(NSAM,2)=15625
  228. Return 
  229. LEARAW:
  230.   TYP$="Raw sound!" : FI=1
  231.   DAT(NSAM,0)=AD : DAT(NSAM,1)=L : DAT(NSAM,2)=15625
  232. Return 
  233. LEABANK:
  234.   Locate 0,13
  235.   If NSAM=15 Then Print "Sorry! Can't load more than 15 sounds at once!" : Wait 100 : Return 
  236.   F$=Fsel$("*.abk","","Select an AMOS sound bank")
  237.   If F$="" Then Return 
  238.   Open In 1,F$ : N$=Input$(1,4) : Close 1
  239.   If N$<>"AmBk" Then Print "This is not an AMOS Bank!" : Wait 100 : Return 
  240.   Load F$,16
  241.   AD=Start(16) : S=0
  242.   A$= Fn GLW$(Leek(AD-8))+ Fn GLW$(Leek(AD-4))
  243.   If A$<>"Samples " Then Print "This is a ";A$;" Bank!" : Wait 100 : Return 
  244.   For A=1+NSAM To Min(Deek(AD)+NSAM,15)
  245.     ADN=Leek(AD+2+S*4)+AD
  246.     DAT(A,2)=Deek(ADN+8)
  247.     DAT(A,1)=Leek(ADN+10)
  248.     DAT$(A,0)= Fn GLW$(Leek(ADN))+ Fn GLW$(Leek(ADN+4))
  249.     DAT$(A,1)="RAW(AMOS BANK)"
  250.     Inc S
  251.     Erase 16-A : Reserve As Chip Work 16-A,DAT(A,1)
  252.     DAT(A,0)=Start(16-A)
  253.     Copy ADN+14,ADN+DAT(A,1)+14 To DAT(A,0)
  254.     Inc NSAM
  255.   Next 
  256.   Erase 16
  257.   SAM=1
  258. Return 
  259. Procedure SAMPSPEED[KANAL,FREQ]
  260.   RATE=3579545/FREQ
  261.   For A=0 To 3
  262.     If Btst(A,KANAL) Then Doke $DFF0A6+A*16,RATE
  263.   Next 
  264. End Proc